Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/Libraries/PNL Libraries/MyHistory.p

Text File | 1994-09-11 | 4KB | 180 lines

unit MyHistory;

interface

{$IFC undefined THINK_Pascal}
    uses
        Files;
{$ENDC}

    const
        H_Null = $12345678;
        H_FromStart = $80000000;

    function HistoryCreate (var fs: FSSpec): OSErr;
{ You should create the file before calling this using FSpCreate.  Any existing data will be destroyed. }
    function HistoryOpen (var fs: FSSpec; var refnum: longInt): OSErr;
    function HistoryFlush (refnum: longInt): OSErr;
    function HistoryClose (refnum: longInt): OSErr;
    function HistoryAdd (refnum: longInt; data: str255): OSErr;
    function HistoryAfter (refnum: longInt; time: longInt; var id: longInt): OSErr;
    function HistoryNext (refnum: longInt; var id: longInt; var time: longInt; var data: str255): OSErr;
    function HistoryExpire (refnum: longInt; time: longInt): OSErr;

implementation

    uses
{$IFC undefined THINK_Pascal}
        Errors,
{$ENDC}
        MyFileSystemUtils, MyMemory, MyMathUtils;

{ File format: }
{ sequence of entries }
{ Entry format: }
{ time:longInt }
{ data:PString }
{ zero:byte }

    type
        EntryRecord = record
                time: longInt;
                data: str255;
                zero: byte;
            end;

    function HistoryCreate (var fs: FSSpec): OSErr;
        var
            err, oerr: OSErr;
            rn: integer;
    begin
        err := FSpOpenDF(fs, fsRdWrPerm, rn);
        if err = noErr then begin
            err := SetEOF(rn, 0);
            oerr := FSClose(rn);
            if err = noErr then
                err := oerr;
        end;
        HistoryCreate := err;
    end;

    function HistoryOpen (var fs: FSSpec; var refnum: longInt): OSErr;
        var
            err, junk: OSErr;
            rn: integer;
    begin
        err := FSpOpenDF(fs, fsRdWrPerm, rn);
        if err = noErr then begin
            if err <> noErr then begin
                junk := FSClose(rn);
            end;
        end;
        refnum := rn;
        if err <> noErr then begin
            refnum := H_Null;
        end;
        HistoryOpen := err;
    end;

    function HistoryFlush (refnum: longInt): OSErr;
        var
            err: OSErr;
            pb: ParamBlockRec;
    begin
        pb.ioRefNum := refnum;
        err := PBFlushFileSync(@pb);
        HistoryFlush := err;
    end;

    function HistoryClose (refnum: longInt): OSErr;
        var
            err: OSErr;
    begin
        if refnum <> H_Null then begin
            err := FSClose(refnum);
        end;
        HistoryClose := err;
    end;

    function HistoryAdd (refnum: longInt; data: str255): OSErr;
        var
            err: OSErr;
            er: EntryRecord;
    begin
        MFill(@er, SizeOf(er), 0);
        GetDateTime(er.time);
        er.data := data;
        err := MyFSWriteAt(refnum, fsFromLEOF, 0, 6 + length(data), @er);
        HistoryAdd := err;
    end;

    function ReadEntry (refnum: longInt; var pos: longInt; var entry: EntryRecord): OSErr;
        var
            err: OSErr;
    begin
        err := MyFSReadAt(refnum, pos, 5, @entry);
        if err = noErr then begin
            err := MyFSReadAt(refnum, pos, 5 + length(entry.data), @entry);
        end;
        if err = noErr then begin
            pos := pos + 6 + length(entry.data);
        end;
        ReadEntry := err;
    end;

    function HistoryAfter (refnum: longInt; time: longInt; var id: longInt): OSErr;
        var
            err: OSErr;
            pos: longInt;
            entry: EntryRecord;
    begin
        pos := 0;
        repeat
            id := pos;
            err := ReadEntry(refnum, pos, entry);
        until (err <> noErr) or (entry.time >= time);
        HistoryAfter := err;
    end;

    function HistoryNext (refnum: longInt; var id: longInt; var time: longInt; var data: str255): OSErr;
        var
            err: OSErr;
            entry: EntryRecord;
    begin
        err := ReadEntry(refnum, id, entry);
        time := entry.time;
        data := entry.data;
        HistoryNext := err;
    end;

    function HistoryExpire (refnum: longInt; time: longInt): OSErr;
        var
            err: OSErr;
            src, dst, len, cnt: longInt;
            buffer: packed array[1..8192] of byte;
    begin
        err := HistoryAfter(refnum, time, src);
        if err = noErr then begin
            err := GetEOF(refnum, len);
            if err = noErr then begin
                len := len - src;
                dst := 0;
                while (err = noErr) & (len > 0) do begin
                    cnt := Min(len, SizeOf(buffer));
                    err := MyFSReadAt(refnum, src, cnt, @buffer);
                    if err = noErr then begin
                        err := MyFSWriteAt(refnum, fsFromStart, dst, cnt, @buffer);
                    end;
                    src := src + cnt;
                    dst := dst + cnt;
                    len := len - cnt;
                end;
            end;
        end
        else if err = eofErr then begin
            err := SetEOF(refnum, 0);
        end;
        HistoryExpire := err;
    end;

end.